home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Info-Mac 4
/
Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso
/
Development
/
Source
/
DBL Pascal Library
/
Strings
/
StringLists.p
Wrap
Text File
|
1992-04-18
|
5KB
|
153 lines
unit StringLists;
interface
{The Set… routines create intervening zero–length strings if needed}
{to fill the list up to the specified index. The Delete… routines ignore}
{requests to delete strings at nonexistent indices. All routines ignore}
{nil handles, missing resources, and negative indices.}
procedure RSetIndString (theString: Str255; rType: ResType; strListID: INTEGER; index: INTEGER);
procedure HSetIndString (theString: Str255; strListHandle: Handle; index: INTEGER);
procedure RGetIndString (var theString: Str255; var found: Boolean; rType: ResType; strListID: INTEGER; index: INTEGER);
procedure HGetIndString (var theString: Str255; var found: Boolean; strListHandle: Handle; index: INTEGER);
procedure RDeleteIndString (rType: ResType; strListID: INTEGER; index: INTEGER);
procedure HDeleteIndString (strListHandle: Handle; index: INTEGER);
function RCountIndString (rType: ResType; strListID: INTEGER): Integer;
function HCountIndString (strListHandle: Handle): Integer;
implementation
type
StringCount = Integer;
StringCountPtr = ^StringCount;
StringCountHandle = ^StringCountPtr;
function FindString (strListHandle: Handle; index: Integer; var aStrPtr: Ptr; var offset: Longint; var length: Integer): Boolean;
var
i, limitIndex: Integer;
pastEnd: Boolean;
begin
aStrPtr := nil;
limitIndex := StringCountHandle(strListHandle)^^;
pastEnd := index > limitIndex;
if pastEnd then
index := limitIndex + 1;
if (strListHandle <> nil) & (index > 0) then
begin
offset := SIZEOF(StringCount);
aStrPtr := Ptr(ORD(strListHandle^) + offset);
length := aStrPtr^ + SIZEOF(SignedByte);
i := 1;
while i < index do
begin
aStrPtr := Ptr(ORD(aStrPtr) + length);
offset := offset + length;
length := aStrPtr^ + SIZEOF(SignedByte);
i := i + 1;
end;
if pastEnd then
length := 0;
FindString := not pastEnd;
end
else
FindString := False;
end;
procedure HSetIndString (theString: Str255; strListHandle: Handle; index: INTEGER);
var
aStrPtr: Ptr;
i: Integer;
offset, ignore: Longint;
oldLength, newLength, padStringCount: Integer;
begin
newLength := length(theString) + SIZEOF(SignedByte);
if FindString(strListHandle, index, aStrPtr, offset, oldLength) then
begin
ignore := Munger(strListHandle, offset, nil, oldLength, @theString, newLength);
end
else
begin
padStringCount := index - StringCountHandle(strListHandle)^^ - 1;
aStrPtr := Ptr(ORD(@theString) - padStringCount * SIZEOF(SignedByte));
ignore := Munger(strListHandle, offset, nil, oldLength, aStrPtr, newLength + padStringCount);
aStrPtr := Ptr(ORD(strListHandle^) + offset);
for i := 1 to padStringCount do
begin
aStrPtr^ := 0;
aStrPtr := Ptr(ORD(aStrPtr) + SIZEOF(SignedByte));
end;
StringCountHandle(strListHandle)^^ := StringCountHandle(strListHandle)^^ + padStringCount + 1;
end;
end;
procedure RSetIndString (theString: Str255; rType: ResType; strListID: INTEGER; index: INTEGER);
var
theStrList: Handle;
begin
theStrList := GetResource(rType, strListID);
HSetIndString(theString, theStrList, index);
ChangedResource(theStrList);
WriteResource(theStrList);
end;
procedure HGetIndString (var theString: Str255; var found: Boolean; strListHandle: Handle; index: INTEGER);
var
aStrPtr: Ptr;
offset: Longint;
length: Integer;
begin
found := FindString(strListHandle, index, aStrPtr, offset, length);
if found then
BlockMove(aStrPtr, @theString, length)
else
theString := '';
end;
procedure RGetIndString (var theString: Str255; var found: Boolean; rType: ResType; strListID: INTEGER; index: INTEGER);
var
theStrList: Handle;
begin
theStrList := GetResource(rType, strListID);
HGetIndString(theString, found, theStrList, index);
end;
procedure HDeleteIndString (strListHandle: Handle; index: INTEGER);
var
aStrPtr: Ptr;
offset: Longint;
length: Integer;
begin
if FindString(strListHandle, index, aStrPtr, offset, length) then
begin
offset := Munger(strListHandle, offset, nil, length, Ptr(-1), 0);
StringCountHandle(strListHandle)^^ := StringCountHandle(strListHandle)^^ - 1;
end;
end;
procedure RDeleteIndString (rType: ResType; strListID: INTEGER; index: INTEGER);
var
theStrList: Handle;
begin
theStrList := GetResource(rType, strListID);
HDeleteIndString(theStrList, index);
ChangedResource(theStrList);
WriteResource(theStrList);
end;
function HCountIndString (strListHandle: Handle): Integer;
begin
if strListHandle = nil then
HCountIndString := 0
else
HCountIndString := StringCountHandle(strListHandle)^^;
end;
function RCountIndString (rType: ResType; strListID: INTEGER): Integer;
var
theStrList: Handle;
begin
theStrList := GetResource(rType, strListID);
RCountIndString := HCountIndString(theStrList);
end;
end.